PlantsGrow Subroutine

public subroutine PlantsGrow(time, radiation, temperature, swc, sfc, swp, rh, co2)

Update plants state variables

Arguments

Type IntentOptional Attributes Name
type(DateTime), intent(in) :: time

current time

type(grid_real), intent(in) :: radiation

shortwave radiation [w/m2]

type(grid_real), intent(in) :: temperature

air temperature [°C]

type(grid_real), intent(in) :: swc

soil water content [m3/m3]

type(grid_real), intent(in) :: sfc

soil field capacity [m3/m3]

type(grid_real), intent(in) :: swp

soil wilting point [m3/m3]

type(grid_real), intent(in) :: rh

air relative humidity [0-1]

real(kind=float), intent(in), optional :: co2

CO2 [ppm]


Variables

Type Visibility Attributes Name Initial
type(PlantsCohort), public, POINTER :: cohort
real(kind=float), public :: fAGE

GPP age modifier

real(kind=float), public :: fCO2

GPP CO2 modifier

real(kind=float), public :: fSWC

GPP soil water content modifier

real(kind=float), public :: fTEMP

GPP temperature modifier

real(kind=float), public :: fVPD

GPP vapor pressure deficit modififer

character(len=300), public :: filename
logical, public :: is_new_year

flag to mark new year has begun

integer(kind=short), public :: k
integer(kind=short), public :: l
real(kind=float), public :: leafaf

leaf allocation factor

real(kind=float), public :: pfs

used to compute stem allocation factor

type(Practice), public :: practice
real(kind=float), public :: rootaf

root allocation factor

real(kind=float), public :: stemaf

stem allocation factor

character(len=300), public :: varname

Source Code

SUBROUTINE  PlantsGrow &
!
(time, radiation, temperature, swc, sfc, swp, rh, co2)

IMPLICIT NONE

!Arguments with intent(in):
TYPE (DateTime), INTENT(IN) :: time !!current time 
TYPE (grid_real), INTENT(IN) :: radiation !!shortwave radiation [w/m2]
TYPE (grid_real), INTENT(IN) :: temperature !!air temperature [°C]
TYPE (grid_real), INTENT(IN) :: swc !! soil water content [m3/m3]
TYPE (grid_real), INTENT(IN) :: sfc !! soil field capacity [m3/m3]
TYPE (grid_real), INTENT(IN) :: swp !! soil wilting point [m3/m3]
TYPE (grid_real), INTENT(IN) :: rh !! air relative humidity  [0-1]
REAL (KIND = float), OPTIONAL, INTENT(IN) :: co2 !! CO2 [ppm]


!local declarations:
CHARACTER (LEN = 300) :: filename, varname
INTEGER (KIND = short) :: k, l
TYPE (PlantsCohort), POINTER :: cohort
REAL (KIND = float) :: fSWC !! GPP soil water content modifier 
REAL (KIND = float) :: fAGE !! GPP age modifier
REAL (KIND = float) :: fTEMP !! GPP temperature modifier
REAL (KIND = float) :: fVPD !! GPP vapor pressure deficit modififer
REAL (KIND = float) :: fCO2 !! GPP CO2 modifier
!REAL (KIND = float) :: deltaMroot !! root mass increment
!REAL (KIND = float) :: deltaMstem !! stem mass increment
REAL (KIND = float) :: rootaf !!root allocation factor
REAL (KIND = float) :: stemaf !! stem allocation factor
REAL (KIND = float) :: leafaf !! leaf allocation factor
REAL (KIND = float) :: pfs !!used to compute stem allocation factor
LOGICAL             :: is_new_year !! flag to mark new year has begun
TYPE (Practice)     :: practice


!------------end of declaration------------------------------------------------  

! need to update vegetation parameters from file?
IF ( simulatePlants == 0) THEN
    !check leaf area index
    IF (  time == lai % next_time ) THEN
        !destroy current grid
        filename = lai % file_name
        varname = lai % var_name
        CALL GridDestroy (lai)
        !read grid in netcdf file
        CALL NewGrid (lai, TRIM(filename), NET_CDF, &
                       variable = TRIM(varname), time = time)	           
    END IF
    
    !check vegetation fraction
    IF (  time == fvcover % next_time ) THEN
        !destroy current grid
        filename = fvcover % file_name
        varname = fvcover % var_name
        CALL GridDestroy (fvcover)
        !read grid in netcdf file
        CALL NewGrid (fvcover, TRIM(filename), NET_CDF, &
                       variable = TRIM(varname), time = time)           
    END IF
    
    !check plants height
    IF (  time == plantsHeight % next_time ) THEN
        !destroy current grid
        filename = plantsHeight % file_name
        varname = plantsHeight % var_name
        CALL GridDestroy (plantsHeight)
        !read grid in netcdf file
        CALL NewGrid (plantsHeight, TRIM(filename), NET_CDF, &
                       variable = TRIM(varname), time = time)           
    END IF
    
    !check minimum stomatal resistance
    IF (  rsMinLoaded .AND. time == rsMin % next_time ) THEN
        !destroy current grid
        filename = rsMin % file_name
        varname = rsMin % var_name
        CALL GridDestroy (rsMin)
        !read grid in netcdf file
        CALL NewGrid (rsMin, TRIM(filename), NET_CDF, &
                       variable = TRIM(varname), time = time)           
    END IF

ELSE !simulate forest dynamics
    year_new = GetYear (time)
    DO k = 1, count_stands 
        
        cohort => forest (k) % first
        DO l = 1, forest (k) % lenght !loop through all cohorts
            
            cohort % stem_yield = 0. 
            !check management practices
            IF ( plants_management ) THEN
               IF ( ALLOCATED (forest (k) % thinning % cuts) ) THEN
                  practice = forest (k) % thinning
                  
                  IF (time > practice % next .AND. practice % current < SIZE ( practice % cuts )) THEN 
    
                     practice % current = practice % current + 1
                     
                     IF ( practice % cuts ( practice % current ) % reforestation ) THEN
                         !set species parameters
                         cohort % species = species ( practice % cuts ( practice % current ) % species)
                     END IF
                     
                  
                     CALL ApplyPlantsManagement (time, practice, cohort % density, &
                                              cohort % mass_root, cohort % mass_stem, &
                                              cohort % mass_leaf, cohort % mass_total, &
                                              cohort % lai, cohort % canopy_cover, &
                                              cohort % age, cohort % height, cohort % dbh, &
                                              cohort % stem_yield )
                     
                     
                      !update crown diameter
                      cohort % crown_diameter = CrownDiameter ( dbh = cohort % dbh, &
                                                 den = cohort % density, &
                                                 denmin = cohort % species % denmin, &
                                                 denmax = cohort % species % denmax, &
                                                 dbhdcmin = cohort % species % dbhdcmin, &
                                                 dbhdcmax = cohort % species % dbhdcmax ) 
                     !update canopy cover
                     cohort % canopy_cover = CanopyCover (  cohort % crown_diameter, cohort % density ) 
                     
                     !update time of next cut
                     IF ( practice % current < SIZE ( practice % cuts ) ) THEN
                         practice % next = practice % cuts (  practice % current + 1 ) % time
                     END IF
                     
                     !copy practice back 
                     forest (k) % thinning = practice 
                     
                  END IF
               END IF
            
            END IF
            
            
            !update age
            IF ( DayOfYear (time) == 1 .AND. year_new /= year_prev ) THEN
                is_new_year = .TRUE.
                cohort % age = cohort % age + 1
                cohort % mass_stem_year_previous = cohort % mass_stem
            ELSE
                is_new_year = .FALSE.
            END IF
            
             !compute APAR
             cohort % apar = AparCalc (rad = radiation % mat (forest (k) % i, forest (k) % j) , &
                                       lai = cohort % lai, &
                                       k = cohort % species % k, &
                                       alb = cohort % species % albedo, &
                                       dt = dtPlants)
             
             
             !compute CO2 modifier
             IF ( useCO2modifier ) THEN
                 fCO2 = CO2mod (co2,  cohort % age )
             ELSE
                 fCO2 = 1.
             END IF
             
             
             
             !compute age modifier
             fAGE = AGEmod ( cohort % age, cohort % species % agemax)
             
             
             !compute temperature modifier 
             fTEMP = TEMPmod (Ta = temperature % mat (forest (k) % i, forest (k) % j), &
                              Tmin =  cohort % species % Tmin, &
                              Tmax =  cohort % species % Tmax, &
                              Topt =  cohort % species % Topt )
             
        
             !compute soil water content modifier
             fSWC = SWCmod (swc = swc % mat (forest (k) % i, forest (k) % j), &
                            wp = swp % mat (forest (k) % i, forest (k) % j), &
                            fc = sfc % mat (forest (k) % i, forest (k) % j), &
                            theta = cohort % species % theta_fswc )
             
             !compute vapor pressure deficit modifier
             fVPD = VPDmod (Ta = temperature % mat (forest (k) % i, forest (k) % j), &
                            RH = rh % mat (forest (k) % i, forest (k) % j), &
                            kd = cohort % species % theta_fvpd)
             
             
             !compute gross primary production
             cohort % gpp = cohort % apar * & ! absorbed photosynthetically active radiation molPAR m-2
                            cohort % species % alpha * &! canopy quantum efficiency (molC/molPAR)
                            C_molar_mass * & !conversion to Kg
                            hectare / & ! m2 in one hectare
                            1000. * & !conversion to t
                            fAGE * & !age modifier
                            fTEMP * & !temperature modifier
                            fSWC * & !soil water content modifier
                            fVPD * &!vapor pressure deficit modifier
                            fCO2
            
             
             !compute net primary production
             cohort % npp = cohort % gpp * cohort % species % GPPtoNPP
             
             !compute root allocation factor 
             rootaf = 0.5 / ( 1. + 2.5 * fAGE * fTEMP * fSWC )
             
             !compute stem allocation factor 
             pfs = (cohort % species % fprn * cohort % species % fpra) / &
                   (cohort % species % sprn * cohort % species % spra) * &
                   (cohort % density * cohort % dbh / 100.) ** &
                   (cohort % species % fprn - cohort % species % sprn)
             
             stemaf = ( 1. - rootaf ) / ( 1. + pfs )
             
             !compute leaf allocation factor
             leafaf = 1. - rootaf - stemaf
             
             ! update stem biomass
             cohort % mass_stem = cohort % mass_stem + stemaf * cohort % npp
             
             !update root biomass
             cohort % mass_root =  cohort % mass_root + & !current mass
                                   rootaf * cohort % npp - & !mass increment
                                   cohort % species % rtr * cohort % mass_root * dtPlants !turnover rate
             
             ! update leaf biomass and leaf area index
             CALL GrowLeaf (npp = cohort % npp , &
                            af = leafaf, &
                            Ta = temperature % mat (forest (k) % i, forest (k) % j), &
                            Tcold = cohort % species % tcold_leaf, &
                            swc = swc % mat (forest (k) % i, forest (k) % j), &
                            swp = swp % mat (forest (k) % i, forest (k) % j), &
                            sfc = sfc % mat (forest (k) % i, forest (k) % j), &
                            tr = cohort % species % ltr, &
                            sla = cohort % species % sla, &
                            mleaf = cohort % mass_leaf, &
                            lai = cohort % lai     )
             
             !update total biomass
             cohort % mass_total = cohort % mass_root + cohort % mass_stem + cohort % mass_leaf
             
             !update dbh and height tree every new year
             !IF (is_new_year) THEN
                 !CALL GrowDBH (cc = cohort % canopy_cover, &
                 !              hdmin = cohort % species % hdmin, & 
                 !              hdmax = cohort % species % hdmax, &
                 !              ws = cohort % mass_stem, &
                 !              dws = cohort % mass_stem - cohort % mass_stem_year_previous, &
                 !              !dws = stemaf * cohort % npp, &
                 !              DBH = cohort % dbh, &
                 !              height = cohort % height)
             
                  CALL GrowDBHech2o (cc = cohort % canopy_cover, &
                               hdmin = cohort % species % hdmin, & 
                               hdmax = cohort % species % hdmax, &
                               ws = cohort % mass_stem, &
                               !dws = cohort % mass_stem - cohort % mass_stem_year_previous, &
                               dws = stemaf * cohort % npp, &
                               DBH = cohort % dbh, &
                               height = cohort % height, &
                               tree_density = cohort % density, &
                               wood_density = cohort % species % wood_density, &
                               age = cohort % age, &
                               maxage = cohort % species % agemax )
             !END IF
                  
             !update crown diameter
             cohort % crown_diameter = CrownDiameter ( dbh = cohort % dbh, den = cohort % density, &
                                                 denmin = cohort % species % denmin, &
                                                 denmax = cohort % species % denmax, &
                                                 dbhdcmin = cohort % species % dbhdcmin, &
                                                 dbhdcmax = cohort % species % dbhdcmax ) 
             
            !update canopy cover
            cohort % canopy_cover = CanopyCover (  cohort % crown_diameter, cohort % density ) 
            
            
            !apply mortality
            IF (mortality) THEN
                CALL KillPlants (dtPlants, cohort % age, cohort % species % agemax, &
                                 cohort % species % ms, cohort % species % mf, &
                                 cohort % species % mr, cohort % species % wSx1000, &
                                 cohort % crown_diameter, cohort % density, &
                                 cohort % canopy_cover, cohort % mass_stem, &
                                 cohort % mass_root, cohort % mass_leaf, &
                                 cohort % mass_total)
            END IF
            
            !jump to next cohort
            cohort => cohort % next
        END DO
         
    END DO
    year_prev = year_new
    
    !update state variable grids
    CALL ForestToGrid (lai, 'lai') 
    CALL ForestToGrid (fvcover, 'fv')
    CALL ForestToGrid (gpp, 'gpp')
    CALL ForestToGrid (npp, 'npp')
    CALL ForestToGrid (carbonroot, 'root')
    CALL ForestToGrid (carbonstem, 'stem')
    CALL ForestToGrid (carbonleaf, 'leaf')
    CALL ForestToGrid (dbh, 'dbh')
    CALL ForestToGrid (plantsHeight, 'height')
    CALL ForestToGrid (density, 'density')
    CALL ForestToGrid (stemyield, 'stemyield')
END IF


RETURN
END SUBROUTINE PlantsGrow